home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tbox100 / toolbox.frm < prev    next >
Text File  |  1995-05-08  |  8KB  |  243 lines
  1. VERSION 2.00
  2. Begin Form frmtoolBox 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   0  'None
  5.    ClientHeight    =   5985
  6.    ClientLeft      =   2040
  7.    ClientTop       =   1725
  8.    ClientWidth     =   1170
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    Height          =   6390
  12.    Icon            =   0
  13.    KeyPreview      =   -1  'True
  14.    Left            =   1980
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   399
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   78
  21.    Top             =   1380
  22.    Width           =   1290
  23.    Begin PictureBox MsgBlaster1 
  24.       BackColor       =   &H000000FF&
  25.       Height          =   1000
  26.       Left            =   0
  27.       ScaleHeight     =   975
  28.       ScaleWidth      =   975
  29.       TabIndex        =   0
  30.       Top             =   0
  31.       Width           =   1000
  32.    End
  33.    Begin Shape Shape1 
  34.       BorderColor     =   &H80000006&
  35.       Height          =   5985
  36.       Left            =   0
  37.       Top             =   0
  38.       Width           =   1170
  39.    End
  40. End
  41. Option Explicit
  42.  
  43. Dim toolBoxActive As Integer
  44. Dim hSysMenu As Long
  45.  
  46. 'Menu ID's
  47. Const IDM_SYSMOVE = 101
  48. Const IDM_SYSCLOSE = 102
  49.  
  50. Sub Form_KeyDown (keyCode As Integer, Shift As Integer)
  51.     If (keyCode = 32) And (Shift = 4) Then
  52.         keyCode = 0
  53.         Shift = 0
  54.         DoEvents
  55.         ShowSysMenu
  56.         End If
  57.     If (keyCode = 115) And (Shift = 4) Then
  58.         keyCode = 0
  59.         Shift = 0
  60.         frmMain!mnuToolbox.Checked = False
  61.         Hide
  62.         End If
  63.     End Sub
  64.  
  65. Sub Form_Load ()
  66.   Dim i%
  67.   
  68.   ' Make the toolbox a top-most window
  69.   i% = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  70.   
  71.   ' Set up message blaster to respond to desired events...
  72.   MsgBlaster1.hWndTarget = hWnd
  73.   MsgBlaster1.MsgList(0) = WM_NCHITTEST
  74.   MsgBlaster1.MsgPassage(0) = EATMESSAGE
  75.   MsgBlaster1.MsgList(1) = WM_CLOSE
  76.   MsgBlaster1.MsgList(2) = WM_NCACTIVATE
  77.   MsgBlaster1.MsgList(3) = WM_NCLBUTTONDBLCLK
  78.   MsgBlaster1.MsgPassage(3) = EATMESSAGE
  79.   MsgBlaster1.MsgList(4) = WM_NCLBUTTONDOWN
  80.   MsgBlaster1.MsgList(5) = WM_COMMAND
  81.   MsgBlaster1.MsgPassage(5) = PREPROCESS
  82.   MsgBlaster1.MsgList(6) = WM_ACTIVATEAPP
  83.   
  84.   ' Create our fake system menu for the toolbox
  85.   ' (I don't use VBs own popup menu function because it lacks
  86.   ' the full functionality of the API function)
  87.   hSysMenu = CreatePopupMenu()
  88.   i% = AppendMenu(hSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSMOVE, "&Move")
  89.   i% = AppendMenu(hSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSCLOSE, "&Close  Alt+F4")
  90.   End Sub
  91.  
  92. Sub Form_Paint ()
  93.   'Refresh the title bar and system menu.  The paint event gets
  94.   'called each time the system colors are changed, so we keep
  95.   'up to date on the fly...
  96.  
  97.   'Vertical line beteen control menu and caption
  98.   '(using the windowframe system color)
  99.   Line (BAR_HEIGHT + 1, 1)-(BAR_HEIGHT + 1, BAR_HEIGHT + 1), WINDOW_FRAME
  100.   'Horizontal line below caption (using the windowframe
  101.   'system color)
  102.   Line (1, BAR_HEIGHT + 1)-(scaleWidth, BAR_HEIGHT + 1), WINDOW_FRAME
  103.   'Fill in control menu (always light gray)
  104.   Line (1, 1)-(BAR_HEIGHT, BAR_HEIGHT), QBColor(7), BF
  105.   'Box for bar in control menu (always black)
  106.   Line (2, (BAR_HEIGHT - 1) \ 2)-Step(BAR_HEIGHT - 4, 2), QBColor(0), B
  107.   'Line inside bar in control menu (always white)
  108.   Line (3, (BAR_HEIGHT - 1) \ 2 + 1)-Step(BAR_HEIGHT - 5, 0), QBColor(15)
  109.   'Vertical shadow on bar in control menu (always dark gray)
  110.   Line (BAR_HEIGHT - 1, (BAR_HEIGHT - 1) \ 2 + 1)-Step(0, 3), QBColor(8)
  111.   'Horizontal shadow on bar in control menu (always dark gray)
  112.   Line (3, (BAR_HEIGHT - 1) \ 2 + 3)-Step(BAR_HEIGHT - 4, 0), QBColor(8)
  113.  
  114.   titleBar
  115.  
  116.   End Sub
  117.  
  118. Sub MsgBlaster1_Message (MsgVal As Integer, wParam As Integer, lParam As Long, lRetVal As Long)
  119.   Dim i%, tc&
  120.   Dim FormTop%
  121.   Dim FormLeft%
  122.   Dim xPos%
  123.   Dim yPos%
  124.  
  125.   'Which message has come to us?
  126.   Select Case MsgVal
  127.   Case WM_ACTIVATEAPP
  128.     'The WM_ACTIVATEAPP message means our app is losing or
  129.     'gaining the focus.  We check this so we can show or hide
  130.     'the floating toolbox.
  131.     If wParam Then
  132.       If frmMain.WindowState <> 1 And frmMain!mnuToolbox.Checked Then frmToolBox.Show
  133.     Else
  134.       Hide
  135.       End If
  136.     lRetVal = 0
  137.   Case WM_NCACTIVATE
  138.     'The WM_NCACTIVATE message means the non-client area of a
  139.     'window requires updating due to a change in the activation
  140.     'state of that window.  All we need to redraw is the title
  141.     'bar.
  142.     If wParam Then
  143.       toolBoxActive = True
  144.     Else
  145.       toolBoxActive = False
  146.       End If
  147.     titleBar
  148.   Case WM_CLOSE
  149.     'Close has been selected from the system menu.
  150.     frmMain!mnuToolbox.Checked = False
  151.     Hide
  152.   Case WM_NCHITTEST
  153.     'This is the magic bit - windows tells us that the user is
  154.     'moving the mouse over our window - it wants us to tell it
  155.     'WHAT the mouse is moving over, so we oblige.  Then, when
  156.     'the user clicks, windows thinks the user has clicked on
  157.     'whatever we have told it the mouse was over.
  158.     FormTop% = top / screen.TwipsPerPixelY
  159.     FormLeft% = Left / screen.TwipsPerPixelX
  160.     xPos% = (lParam And &HFFFF&) - FormLeft%
  161.     yPos% = (lParam / 65536) - FormTop%
  162.     If (yPos% < BAR_HEIGHT + 2) And (xPos% < BAR_HEIGHT + 2) Then
  163.       'Tell windows the mouse is over the system menu...
  164.       lRetVal = HTSYSMENU
  165.     ElseIf (yPos% < BAR_HEIGHT + 2) Then
  166.       'Tell windows the mouse is over the title bar...
  167.       lRetVal = HTCAPTION
  168.     Else
  169.       ' Tell windows the mouse is over the client area...
  170.       lRetVal = HTCLIENT
  171.       End If
  172.   Case WM_NCLBUTTONDBLCLK
  173.     'A double click in the non-client area!  If it is over the
  174.     'system menu then we close (hide) the toolbox...
  175.     If wParam = HTSYSMENU Then
  176.       frmMain!mnuToolbox.Checked = False
  177.       Hide
  178.       End If
  179.   Case WM_NCLBUTTONDOWN
  180.     'A buttondown in the non-client area!  If it is over the
  181.     'system menu then we show the system menu...
  182.     If wParam = HTSYSMENU Then
  183.       ShowSysMenu
  184.       End If
  185.   Case WM_COMMAND
  186.     'A command message (meaning a command button or menu-item
  187.     'has been selected).
  188.     Select Case wParam
  189.       Case IDM_SYSMOVE
  190.         'If the move menu item was selected, send a move command.
  191.         tc& = SendMessage(hWnd, WM_SYSCOMMAND, SC_MOVE, 0)
  192.       Case IDM_SYSCLOSE
  193.         'If the close menu item was selected, close the window.
  194.         frmMain!mnuToolbox.Checked = False
  195.         Hide
  196.     End Select
  197.   End Select
  198. End Sub
  199.  
  200. Sub ShowSysMenu ()
  201.   Dim ScreenRect As Rect
  202.   Dim InPixels As Single
  203.   Dim IX As Single
  204.   Dim IY As Single
  205.   Dim RC%
  206.  
  207.   'Set up the rectangle that defines an area where the mouse
  208.   'can be clicked without dismissing the menu.  This lets the
  209.   'user click and release over the system menu and the menu
  210.   'stays up.  VBs built in popup menu function doesn't support
  211.   'this.
  212.   ScaleMode = 1
  213.   ScreenRect.Left = Left \ screen.TwipsPerPixelX
  214.   ScreenRect.Right = ScreenRect.Left + BAR_HEIGHT + 2
  215.   ScreenRect.top = top \ screen.TwipsPerPixelY
  216.   ScreenRect.bottom = ScreenRect.top + BAR_HEIGHT + 2
  217.   ScaleMode = 3
  218.  
  219.   IX = ScreenRect.Left
  220.   IY = ScreenRect.bottom - 1
  221.  
  222.   'If the menu will go off the bottom of the screen, make it
  223.   'draw ABOVE the control box.  Note that Windows won't draw a
  224.   'menu off the screen, but it will draw it covering the control
  225.   'box.  Normal control menus don't do this.
  226.   If (IY + 2 * GetSystemMetrics(SM_CYMENU) + 3) > (screen.Height \ screen.TwipsPerPixelY) Then IY = IY - (2 * GetSystemMetrics(SM_CYMENU)) - 12
  227.   RC% = TrackPopupMenu(hSysMenu, 0, IX, IY, 0, hWnd, ScreenRect)
  228.   End Sub
  229.  
  230. Sub titleBar ()
  231.   'Paint titleBar
  232.   If toolBoxActive Then
  233.     'If the toolbox is the active window then paint
  234.     'with the active title bar color
  235.     Line (BAR_HEIGHT + 2, 1)-Step(scaleWidth - BAR_HEIGHT - 4, BAR_HEIGHT - 1), ACTIVE_TITLE_BAR, BF
  236.   Else
  237.     'If the toolbox is inactive then paint with the
  238.     'inactive title bar color
  239.     Line (BAR_HEIGHT + 2, 1)-Step(scaleWidth - BA